#!/usr/bin/perl
#
# Login script
# Parameters:
# - encrypted id
#
use CGI;
use MD5Cookies;
use Counter;
use CounterCGI;
use ErrorForm;
use CGI::Carp;
use POSIX qw(strftime);
$q = new CGI;

$id = $q->param("id");
$tourl = $q->param("url");
$tourl = "http://counter.li.org" . $tourl;
$testcookie = $q->cookie("cookiesenabled");
if ($id == "") {
    warn "Renewal attempt without an id";
    errorForm("The script is called without a proper id");
}
$id =~ s/\s+$//; # strip trailing spaces

my ($userid, $garbage) = split("/", $id);
$userid = "#" . $userid;
# warn "$userid, $id";

if (!$testcookie) {
    # test if this is THE problem
    # later version will have an error message here
    warn "User $userid [$ENV{REMOTE_ADDR}] appears not to have cookie support\n";
}

$users = Counter::open();
if ($userid !~ /^#?(\d+)(-\d+)?$/) {
    if (!$userid) {
        warn "Incorrect userid - userid $userid\n";
        errorForm("Userid not correct");
    }
    warn "Login user $userid by name\n";
    $user = $users->getbykey("login", $userid);
} else {
    warn "Login user $userid by number\n";
    if ($userid =~ /^#?(\d+)(-\d+)?$/) {
        $userid = $1;
    }
    $user = $users->get($userid);
}

if (!$user) {
    warn "Login user $userid failed - bad userid\n";
    errorForm("no such user", $userid);
}

# Verify if id and user password match and time constraint holds
# If this test passes user is positively verified and logged in.
$verified = MD5Cookies::tverify($id, $user->{key});
if (!$verified) {
warn "Verification for user $userid failed because of passing time constraints";
errorForm "Verification of your id failed using the one-click renewal link. This is either caused by the fact that you waited more than a week after receiving the email to use the one-click renewal link or the link sent to you is corrupt. To verify your information now and prevent freezing of your registration, please go to the site and log in manually with id and password provided.";
}

# Thaw the user if he is frozen, mark OK if he is bad
if ($user->{state} eq "frozen") {
    warn "User $userid thawed\n";
    $user->thaw();
}
if ($user->{state} eq "bad") {
    $user->{state} = "ok";
}

# Note that the user is logged in
$user->{logintime} = strftime "%Y-%m-%d %H:%M:%S", gmtime();
$user->store();

warn "Login $userid [$ENV{REMOTE_ADDR}] identified by $inputid\n";

$logincookie = CounterCGI::logincookie($user, $q);

if (!$testcookie) {
    #errorForm("no cookies", $user->key(), $ENV{REMOTE_ADDR});
    warn $user->key(), $ENV{REMOTE_ADDR}, ": No cookie - attempting argument redirect\n";
    my $logintoken = urlescape(CounterCGI::logintoken($user));
    if ($tourl =~ /\?/) {
        $tourl .= "&nocookie=$logintoken";
    } else {
        $tourl .= "?nocookie=$logintoken";
    }
}

# Try to set the cookies whether the user can use them or not.

if ($user->{login}) {
    $admincookie = $q->cookie(-name => "adminuser",
                          -value => $user->{login},
                          -expires => "+24h",
                          -path => "/",
                          -domain => $domain);
    $x = $q->header(-cookie=>$admincookie);
    $x =~ s/[\r\n]+$//; # remove the header-terminating blankline
    print $x;
    print "\r\n";
}

$x = $q->header(-cookie=>$logincookie);
$x =~ s/[\r\n]+$//; # remove the header-terminating blankline
print $x;
print "\r\n";
# Note - redirect() terminates the header...
$y = $q->redirect($tourl);
print $y;
print <<EoF;
<html><head>
<title>You should have been redirected</title>
</head><body>
You should not have seen this. You should have been at
<a href="$tourl">$tourl</a>.
<p>
EoF
print "Please report the bug to " . emailCloaking("webmaster\@counter.li.org",0);
print "\n</body>\n</html>";

# That's all...

# URL-encode data
# code stolen from Perl 5.6.1 CGI::Util module
sub urlescape {
  my $toencode = shift;
  return undef unless defined($toencode);
  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
  return $toencode;
}
